VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsXPMenu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'* Menu properties
Private mnuName As String

'* Menu constants
Const XBuffer As Long = 4
Const YBuffer As Long = 4

Const dim_MarginWidth As Long = 23
Const fnt_MenuItem  As String = "Tahoma"

'* Width
Private mnuWidth As Long
Private theTextHeight As Long

'Private frmMenu As New frmXPMenu
'Private ActivePopup As New clsXPMenu

Private bVisible As Boolean
Private bPopupShown As Boolean
Private Yhilight As Long

'* image list
Private imageLst As New cCommandBarImageList

'* Menu array
Private MenuItems()     As typMenuItem
Private MenuItemCount   As Long
Private hilightedItem   As Long
 
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function FrameRect Lib "USER32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FillRect Lib "USER32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SetParent Lib "USER32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function ShowWindow Lib "USER32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function EnableWindow Lib "USER32" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
Private Const SW_HIDE = 0
Private Const SW_SHOW = 5

Private IconCount As Long, ny As Long, ib As Boolean
Private mbar As IEventContainer
Private trans As Long

Public Enum enumStyle
 MS_Normal = 0
 MS_Seperator = 1
 MS_Panel = 2
 MS_IconSeperator = 3
 MS_Checkbox = 4
 MS_OptionButton = 5
 MS_OptionNullable = 6
End Enum

Friend Property Get fMenuItem(ByVal Index As Long) As typMenuItem
fMenuItem = MenuItems(Index)
End Property

Friend Property Let fMenuItem(ByVal Index As Long, d As typMenuItem)
MenuItems(Index) = d
End Property

Public Sub AddItem(Optional ByVal Key As String, Optional ByVal IconNum As Long, Optional ByVal Caption As String, Optional ByVal Style As enumStyle, Optional mnuSubitem As clsXPMenu = Nothing, Optional ByVal Enable As Boolean = True, Optional ByVal Checked As Boolean, Optional ByVal Graphical As Boolean, Optional ByVal GroupName As String, Optional ByVal PanelWidth As Long, Optional ByVal PanelHeight As Long, Optional PanelObject As Object, Optional ByVal AlwaysDropDown As Boolean)
    Dim theWidth As Integer
    Dim iw As Long
    iw = imageLst.IconWidth
    If iw = 0 Then iw = 16
       
    MenuItemCount = MenuItemCount + 1
    ReDim Preserve MenuItems(1 To MenuItemCount) As typMenuItem
    
    With MenuItems(MenuItemCount)
        .IconNum = IconNum
        .Text = Caption
        .st = Style
        .bPopupmenu = Not mnuSubitem Is Nothing
        Set .mnuSubMenu = mnuSubitem
        .en = Enable
        .cd = Checked
        .gn = GroupName
        .gf = Graphical
        .dd = AlwaysDropDown
        'TODO:Visible!
        .vs = True

'////////////////////////////
'If Graphical Then
' If IconCount = 0 Then
'  ny = GetHeight - 4
' End If
' .x = 12 + (iw + 3) * (IconCount + 1)
' .y = ny
' IconCount = IconCount + 1
' theWidth = .x + iw + 8
' If theWidth > mnuWidth Then mnuWidth = theWidth
'Else
' IconCount = 0
'End If
''============
If .st = 2 Then
 .x = PanelWidth
 .y = PanelHeight
 Set .obj = PanelObject
 .obj_hwnd = PanelObject.hWnd
 ShowWindow .obj_hwnd, SW_HIDE
 'check width
 theWidth = .x + iw + 8
 If theWidth > mnuWidth Then mnuWidth = theWidth
End If
''////////////////////////////
'
    End With
'
'    With frmMenu
'        theWidth = .TextWidth(Caption) + (XBuffer * 4) + dim_MarginWidth - 6 + iw
'
'        'If bPopupmenu Then
'        '    theWidth = theWidth + (XBuffer * 2) + frmMenu.picPopup.TextWidth("4")
'        'End If
'
'        If theWidth > mnuWidth Then mnuWidth = theWidth
'    End With
    
End Sub

Function GetHilightNum() As Integer
    GetHilightNum = hilightedItem
End Function

Friend Function GetItemText(itemNum As Integer) As String
    If itemNum > MenuItemCount Then
        GetItemText = ""
        Exit Function
    End If
    
    GetItemText = MenuItems(itemNum).Text
End Function

Public Function GetMenuName()
    GetMenuName = mnuName
End Function

Friend Function IsTextItem(ByVal itemNum As Integer) As Boolean
    If itemNum > MenuItemCount Or itemNum <= 0 Then
        IsTextItem = False
        Exit Function
    End If
    With MenuItems(itemNum)
     If .bPopupmenu Or .st = 1 Or .st = 3 Or Not .en Then
      IsTextItem = False
     Else
      IsTextItem = True
     End If
    End With
End Function

Function IsVisible() As Boolean
    IsVisible = bVisible
End Function

Sub Init(strMenuName As String, Optional hIml As Long)
'Dim i As Long
'
'    mnuName = strMenuName
'
'    Set frmMenu.XPMenuClass = Me
    
    imageLst.Init hIml
    imageLst.HighlightColor = vbYellow
'    frmMenu.FontName = fnt_MenuItem
'    frmMenu.picMenuBuffer.FontName = fnt_MenuItem
'
'    theTextHeight = frmMenu.picMenuBuffer.TextHeight("gW")
''////////
'i = imageLst.IconHeight - 2
'If i > theTextHeight Then theTextHeight = i
''////////
'    MenuItemCount = 0
'    hilightedItem = 0
End Sub

Friend Sub PreInit(EventContainer As IEventContainer)
Set mbar = EventContainer
End Sub

Friend Sub fMenuClick(ByVal Index As Long)
Dim i As Long
'///////////////////internal procress
With MenuItems(Index)
 Select Case .st
 Case 4 'checkbox
  .cd = Not .cd
 Case 5, 6 'option button
  If .cd = True Then
   If .st = 6 Then .cd = False
  Else
   For i = 1 To MenuItemCount
    If MenuItems(i).gn = .gn And MenuItems(i).st = .st Then
     MenuItems(i).cd = i = Index
    End If
   Next i
  End If
 End Select
 'TODO:RaiseEvent
 If Not mbar Is Nothing Then
  mbar.fClick Me, Index
 End If
End With
End Sub

Friend Property Get IconWidth() As Long
Dim n As Long
n = imageLst.IconWidth
If n = 0 Then n = 16
IconWidth = n
End Property

Friend Property Get IconHeight() As Long
Dim n As Long
n = imageLst.IconHeight
If n = 0 Then n = 16
IconHeight = n
End Property
'
'Public Property Get HighlightItem() As Long
'HighlightItem = hilightedItem
'End Property
'
'Public Property Let HighlightItem(ByVal n As Long)
'setHilightedItem n
'End Property

Private Sub class_Terminate()
'xzx
End Sub

Friend Property Get ImlObject() As cCommandBarImageList
Set ImlObject = imageLst
End Property

Public Property Get MenuCount() As Long
MenuCount = MenuItemCount
End Property
